18 January 2022

Brand Rating Data: Loading Data

brand.ratings <- read.csv("http://goo.gl/IQl8nc")

RStudio Screenshot

Brand Rating Data

head(brand.ratings)
##   perform leader latest fun serious bargain value trendy rebuy brand
## 1       2      4      8   8       2       9     7      4     6     a
## 2       1      1      4   7       1       1     1      2     2     a
## 3       2      3      5   9       2       9     5      1     6     a
## 4       1      6     10   8       3       4     5      2     1     a
## 5       1      1      5   8       1       9     9      1     1     a
## 6       2      8      9   5       3       8     7      1     2     a

Brand Rating Data: Summary

summary(brand.ratings)
##     perform           leader           latest            fun        
##  Min.   : 1.000   Min.   : 1.000   Min.   : 1.000   Min.   : 1.000  
##  1st Qu.: 1.000   1st Qu.: 2.000   1st Qu.: 4.000   1st Qu.: 4.000  
##  Median : 4.000   Median : 4.000   Median : 7.000   Median : 6.000  
##  Mean   : 4.488   Mean   : 4.417   Mean   : 6.195   Mean   : 6.068  
##  3rd Qu.: 7.000   3rd Qu.: 6.000   3rd Qu.: 9.000   3rd Qu.: 8.000  
##  Max.   :10.000   Max.   :10.000   Max.   :10.000   Max.   :10.000  
##     serious          bargain           value            trendy     
##  Min.   : 1.000   Min.   : 1.000   Min.   : 1.000   Min.   : 1.00  
##  1st Qu.: 2.000   1st Qu.: 2.000   1st Qu.: 2.000   1st Qu.: 3.00  
##  Median : 4.000   Median : 4.000   Median : 4.000   Median : 5.00  
##  Mean   : 4.323   Mean   : 4.259   Mean   : 4.337   Mean   : 5.22  
##  3rd Qu.: 6.000   3rd Qu.: 6.000   3rd Qu.: 6.000   3rd Qu.: 7.00  
##  Max.   :10.000   Max.   :10.000   Max.   :10.000   Max.   :10.00  
##      rebuy           brand          
##  Min.   : 1.000   Length:1000       
##  1st Qu.: 1.000   Class :character  
##  Median : 3.000   Mode  :character  
##  Mean   : 3.727                     
##  3rd Qu.: 5.000                     
##  Max.   :10.000

Brand Rating Data: Structure

str(brand.ratings)
## 'data.frame':    1000 obs. of  10 variables:
##  $ perform: int  2 1 2 1 1 2 1 2 2 3 ...
##  $ leader : int  4 1 3 6 1 8 1 1 1 1 ...
##  $ latest : int  8 4 5 10 5 9 5 7 8 9 ...
##  $ fun    : int  8 7 9 8 8 5 7 5 10 8 ...
##  $ serious: int  2 1 2 3 1 3 1 2 1 1 ...
##  $ bargain: int  9 1 9 4 9 8 5 8 7 3 ...
##  $ value  : int  7 1 5 5 9 7 1 7 7 3 ...
##  $ trendy : int  4 2 1 2 1 1 1 7 5 4 ...
##  $ rebuy  : int  6 2 6 1 1 2 1 1 1 1 ...
##  $ brand  : chr  "a" "a" "a" "a" ...

The Dimensionality Problem

1D

The Dimensionality Problem

2D

The Dimensionality Problem

3D

Bivariate Correlations

cor(brand.ratings.means[, 2:10])
##              perform      leader       latest        fun      serious
## perform  1.000000000  0.66073151 -0.258730125 -0.7640855  0.629973310
## leader   0.660731514  1.00000000  0.012264047 -0.8094976  0.951151730
## latest  -0.258730125  0.01226405  1.000000000  0.3188666  0.008612981
## fun     -0.764085534 -0.80949757  0.318866591  1.0000000 -0.743040353
## serious  0.629973310  0.95115173  0.008612981 -0.7430404  1.000000000
## bargain  0.127264450  0.08202056 -0.620974023 -0.2018282 -0.004474103
## value    0.208052640  0.17399660 -0.705973921 -0.3603228  0.065190457
## trendy  -0.009716477  0.13646220  0.831557451  0.1610722  0.227623914
## rebuy    0.550162549  0.38481684 -0.755749762 -0.5496990  0.324762755
##              bargain       value       trendy      rebuy
## perform  0.127264450  0.20805264 -0.009716477  0.5501625
## leader   0.082020563  0.17399660  0.136462199  0.3848168
## latest  -0.620974023 -0.70597392  0.831557451 -0.7557498
## fun     -0.201828159 -0.36032280  0.161072218 -0.5496990
## serious -0.004474103  0.06519046  0.227623914  0.3247628
## bargain  1.000000000  0.95555229 -0.760809215  0.7454187
## value    0.955552292  1.00000000 -0.819903233  0.7846262
## trendy  -0.760809215 -0.81990323  1.000000000 -0.5418059
## rebuy    0.745418712  0.78462624 -0.541805889  1.0000000

Bivariate Correlations

Bivariate Correlations

corrplot(cor(brand.ratings.means[, 2:10]), order="hclust")

Questions of Scale

Mandelbot Set

Brand Rating Data: Raw

Ratings given for performance: raw

Brand Rating Data: Raw Ratings

ggplot(brand.ratings %>% group_by(perform) %>% 
         rename(rating = perform) %>% 
         summarise(n=n()),
       aes(x=rating, y=n)) +
  geom_col(fill=this_palette[2]) +
  scale_x_continuous(breaks=1:10,
                     labels=1:10)

Brand Rating Data: Centering

brand.ratings <- brand.ratings %>% 
  as_tibble() %>%
  mutate(perform_centered = perform - mean(perform))

brand.ratings %>% select(perform, perform_centered)
## # A tibble: 1,000 Ă— 2
##    perform perform_centered
##      <int>            <dbl>
##  1       2            -2.49
##  2       1            -3.49
##  3       2            -2.49
##  4       1            -3.49
##  5       1            -3.49
##  6       2            -2.49
##  7       1            -3.49
##  8       2            -2.49
##  9       2            -2.49
## 10       3            -1.49
## # … with 990 more rows

Brand Rating Data: Centered

Ratings given for performance: centered

Brand Rating Data: Raw

Ratings given for performance: raw

Brand Rating Data: Raw and Centered

Ratings given for performance: raw and centered

Brand Rating Data: Standardizing

brand.ratings <- brand.ratings %>%
  mutate(perform_std = perform_centered/sd(perform))

brand.ratings %>% select(perform, perform_centered, perform_std)
## # A tibble: 1,000 Ă— 3
##    perform perform_centered perform_std
##      <int>            <dbl>       <dbl>
##  1       2            -2.49      -0.777
##  2       1            -3.49      -1.09 
##  3       2            -2.49      -0.777
##  4       1            -3.49      -1.09 
##  5       1            -3.49      -1.09 
##  6       2            -2.49      -0.777
##  7       1            -3.49      -1.09 
##  8       2            -2.49      -0.777
##  9       2            -2.49      -0.777
## 10       3            -1.49      -0.464
## # … with 990 more rows

Brand Rating Data: Standardized

Ratings given for performance: standardized

Brand Rating Data: Centered

Ratings given for performance: centered

Brand Rating Data: Raw

Ratings given for performance: raw

Brand Rating Data: All

Ratings given for performance: raw, centered, and standardized

The Scale Function

scale(1:10, center = TRUE, scale = TRUE)
##             [,1]
##  [1,] -1.4863011
##  [2,] -1.1560120
##  [3,] -0.8257228
##  [4,] -0.4954337
##  [5,] -0.1651446
##  [6,]  0.1651446
##  [7,]  0.4954337
##  [8,]  0.8257228
##  [9,]  1.1560120
## [10,]  1.4863011
## attr(,"scaled:center")
## [1] 5.5
## attr(,"scaled:scale")
## [1] 3.02765

The Scale Function

brand.ratings %>%
  mutate(perform_scaled = scale(perform, center = TRUE, scale = TRUE)) %>%
  select(perform_std, perform_scaled)
## # A tibble: 1,000 Ă— 2
##    perform_std perform_scaled[,1]
##          <dbl>              <dbl>
##  1      -0.777             -0.777
##  2      -1.09              -1.09 
##  3      -0.777             -0.777
##  4      -1.09              -1.09 
##  5      -1.09              -1.09 
##  6      -0.777             -0.777
##  7      -1.09              -1.09 
##  8      -0.777             -0.777
##  9      -0.777             -0.777
## 10      -0.464             -0.464
## # … with 990 more rows

Scaling Everything: Base Way

brand.sc <- brand.ratings[, 1:10]
brand.sc[, 1:9] <- data.frame(scale(brand.ratings[, 1:9], center = TRUE, scale = TRUE))
summary(brand.sc)
##     perform            leader            latest             fun          
##  Min.   :-1.0888   Min.   :-1.3100   Min.   :-1.6878   Min.   :-1.84677  
##  1st Qu.:-1.0888   1st Qu.:-0.9266   1st Qu.:-0.7131   1st Qu.:-0.75358  
##  Median :-0.1523   Median :-0.1599   Median : 0.2615   Median :-0.02478  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.7842   3rd Qu.: 0.6069   3rd Qu.: 0.9113   3rd Qu.: 0.70402  
##  Max.   : 1.7206   Max.   : 2.1404   Max.   : 1.2362   Max.   : 1.43281  
##     serious           bargain             value             trendy        
##  Min.   :-1.1961   Min.   :-1.22196   Min.   :-1.3912   Min.   :-1.53897  
##  1st Qu.:-0.8362   1st Qu.:-0.84701   1st Qu.:-0.9743   1st Qu.:-0.80960  
##  Median :-0.1163   Median :-0.09711   Median :-0.1405   Median :-0.08023  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.6036   3rd Qu.: 0.65279   3rd Qu.: 0.6933   3rd Qu.: 0.64914  
##  Max.   : 2.0434   Max.   : 2.15258   Max.   : 2.3610   Max.   : 1.74319  
##      rebuy            brand          
##  Min.   :-1.0717   Length:1000       
##  1st Qu.:-1.0717   Class :character  
##  Median :-0.2857   Mode  :character  
##  Mean   : 0.0000                     
##  3rd Qu.: 0.5003                     
##  Max.   : 2.4652

Scaling Everything: Tidy Way

brand_sc <- brand.ratings %>% 
  select(-c(perform_centered, perform_std)) %>%
  mutate(across(perform:rebuy, ~ scale(.x, center = TRUE, scale = TRUE)[,1]))

summary(brand_sc)
##     perform            leader            latest             fun          
##  Min.   :-1.0888   Min.   :-1.3100   Min.   :-1.6878   Min.   :-1.84677  
##  1st Qu.:-1.0888   1st Qu.:-0.9266   1st Qu.:-0.7131   1st Qu.:-0.75358  
##  Median :-0.1523   Median :-0.1599   Median : 0.2615   Median :-0.02478  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.7842   3rd Qu.: 0.6069   3rd Qu.: 0.9113   3rd Qu.: 0.70402  
##  Max.   : 1.7206   Max.   : 2.1404   Max.   : 1.2362   Max.   : 1.43281  
##     serious           bargain             value             trendy        
##  Min.   :-1.1961   Min.   :-1.22196   Min.   :-1.3912   Min.   :-1.53897  
##  1st Qu.:-0.8362   1st Qu.:-0.84701   1st Qu.:-0.9743   1st Qu.:-0.80960  
##  Median :-0.1163   Median :-0.09711   Median :-0.1405   Median :-0.08023  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.: 0.6036   3rd Qu.: 0.65279   3rd Qu.: 0.6933   3rd Qu.: 0.64914  
##  Max.   : 2.0434   Max.   : 2.15258   Max.   : 2.3610   Max.   : 1.74319  
##      rebuy            brand          
##  Min.   :-1.0717   Length:1000       
##  1st Qu.:-1.0717   Class :character  
##  Median :-0.2857   Mode  :character  
##  Mean   : 0.0000                     
##  3rd Qu.: 0.5003                     
##  Max.   : 2.4652

Scaling Everything: Tidy vs. Base

all_equal(brand_sc, brand.sc)
## [1] TRUE

PCA: Toy Example 1

xvar = runif(100)
yvar = xvar + runif(100, 0, .2)

this_data = data.frame(xvar, yvar)

head(this_data)
##          xvar      yvar
## 1 0.164341562 0.2203344
## 2 0.003638373 0.1960644
## 3 0.476164855 0.5655818
## 4 0.611041508 0.6173938
## 5 0.025305777 0.2171973
## 6 0.826214486 0.9416138
cor(this_data)
##           xvar      yvar
## xvar 1.0000000 0.9765033
## yvar 0.9765033 1.0000000

PCA: Toy Example 1

PCA: Toy Example 1

this_pca = prcomp(this_data)

this_pca
## Standard deviations (1, .., p=2):
## [1] 0.40514646 0.04415934
## 
## Rotation (n x k) = (2 x 2):
##            PC1        PC2
## xvar 0.6978196  0.7162736
## yvar 0.7162736 -0.6978196
summary(this_pca)
## Importance of components:
##                           PC1     PC2
## Standard deviation     0.4051 0.04416
## Proportion of Variance 0.9883 0.01174
## Cumulative Proportion  0.9883 1.00000
names(this_pca)
## [1] "sdev"     "rotation" "center"   "scale"    "x"
head(this_pca$x)
##              PC1          PC2
## [1,] -0.55862218  0.027746073
## [2,] -0.68814803 -0.070425242
## [3,] -0.09373425  0.010176541
## [4,]  0.03749691  0.070629675
## [5,] -0.65789115 -0.069652398
## [6,]  0.41987905 -0.001494658

PCA: Toy Example 1

PCA: Toy Example 1

biplot(this_pca, pc.biplot=TRUE)

PCA: Toy Example 1

autoplot(this_pca, loadings = TRUE,  loadings.label = TRUE)

PCA: Toy Example 2

set.seed(98286)
xvar <- sample(1:10, 100, replace=TRUE)
yvar <- xvar
yvar[sample(1:length(yvar), 50)] <- sample(1:10, 50, replace=TRUE) 
zvar <- yvar
zvar[sample(1:length(zvar), 50)] <- sample(1:10, 50, replace=TRUE) 
my.vars <- cbind(xvar, yvar, zvar)

PCA: Toy Example 2

ggplot(as_tibble(my.vars), aes(x=xvar, y=yvar)) + geom_jitter()

PCA: Toy Example 2

cor(my.vars)
##           xvar      yvar      zvar
## xvar 1.0000000 0.5280585 0.1055090
## yvar 0.5280585 1.0000000 0.4270702
## zvar 0.1055090 0.4270702 1.0000000

PCA: Toy Example 2

pairs(my.vars)

PCA: Toy Example 2

corrplot(cor(my.vars), order="hclust")

PCA: Toy Example 2

PCA: Toy Example 2

my.pca <- prcomp(my.vars)
summary(my.pca)
## Importance of components:
##                           PC1    PC2    PC3
## Standard deviation     3.6040 2.5518 1.6652
## Proportion of Variance 0.5832 0.2923 0.1245
## Cumulative Proportion  0.5832 0.8755 1.0000
my.pca
## Standard deviations (1, .., p=3):
## [1] 3.604044 2.551832 1.665190
## 
## Rotation (n x k) = (3 x 3):
##            PC1        PC2        PC3
## xvar 0.5976189 -0.6124015  0.5175094
## yvar 0.6809830  0.0469915 -0.7307899
## zvar 0.4232183  0.7891490  0.4451180

PCA: Toy Example 2

cor(my.pca$x)
##              PC1          PC2          PC3
## PC1 1.000000e+00 2.107208e-16 3.247515e-16
## PC2 2.107208e-16 1.000000e+00 6.052986e-16
## PC3 3.247515e-16 6.052986e-16 1.000000e+00

PCA: Toy Example 2

plot(my.pca, type="l")

PCA: Toy Example 2

biplot(my.pca)

PCA: Brand Ratings

brand.pc <- prcomp(brand.sc[, 1:9])
summary(brand.pc)
## Importance of components:
##                          PC1    PC2    PC3    PC4     PC5     PC6     PC7
## Standard deviation     1.726 1.4479 1.0389 0.8528 0.79846 0.73133 0.62458
## Proportion of Variance 0.331 0.2329 0.1199 0.0808 0.07084 0.05943 0.04334
## Cumulative Proportion  0.331 0.5640 0.6839 0.7647 0.83554 0.89497 0.93831
##                            PC8     PC9
## Standard deviation     0.55861 0.49310
## Proportion of Variance 0.03467 0.02702
## Cumulative Proportion  0.97298 1.00000

PCA: Brand Ratings

brand.pc
## Standard deviations (1, .., p=9):
## [1] 1.7260636 1.4479474 1.0388719 0.8527667 0.7984647 0.7313298 0.6245834
## [8] 0.5586112 0.4930993
## 
## Rotation (n x k) = (9 x 9):
##                PC1         PC2         PC3         PC4         PC5        PC6
## perform  0.2374679  0.41991179  0.03854006 -0.52630873  0.46793435 -0.3370676
## leader   0.2058257  0.52381901 -0.09512739 -0.08923461 -0.29452974 -0.2968860
## latest  -0.3703806  0.20145317 -0.53273054  0.21410754  0.10586676 -0.1742059
## fun     -0.2510601 -0.25037973 -0.41781346 -0.75063952 -0.33149429  0.1405367
## serious  0.1597402  0.51047254 -0.04067075  0.09893394 -0.55515540  0.3924874
## bargain  0.3991731 -0.21849698 -0.48989756  0.16734345 -0.01257429 -0.1393966
## value    0.4474562 -0.18980822 -0.36924507  0.15118500 -0.06327757 -0.2195327
## trendy  -0.3510292  0.31849032 -0.37090530  0.16764432  0.36649697  0.2658186
## rebuy    0.4390184  0.01509832 -0.12461593 -0.13031231  0.35568769  0.6751400
##                  PC7         PC8         PC9
## perform  0.364179109 -0.14444718  0.05223384
## leader  -0.613674301  0.28766118 -0.17889453
## latest  -0.185480310 -0.64290436  0.05750244
## fun     -0.007114761  0.07461259  0.03153306
## serious  0.445302862 -0.18354764  0.09072231
## bargain  0.288264900  0.05789194 -0.64720849
## value    0.017163011  0.14829295  0.72806108
## trendy   0.153572108  0.61450289  0.05907022
## rebuy   -0.388656160 -0.20210688 -0.01720236

PCA: Brand Ratings

plot(brand.pc, type="l")

PCA: Brand Ratings

biplot(brand.pc)

PCA: Brand Ratings

brand.mean = as.data.frame(brand.ratings.means)

rownames(brand.mean) = brand.mean[,1]
brand.mean = brand.mean[,-1]

brand.mu.pc <- prcomp(brand.mean, scale=TRUE)

summary(brand.mu.pc)
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     2.1345 1.7349 0.7690 0.61498 0.50983 0.36662 0.21506
## Proportion of Variance 0.5062 0.3345 0.0657 0.04202 0.02888 0.01493 0.00514
## Cumulative Proportion  0.5062 0.8407 0.9064 0.94842 0.97730 0.99223 0.99737
##                            PC8     PC9
## Standard deviation     0.14588 0.04867
## Proportion of Variance 0.00236 0.00026
## Cumulative Proportion  0.99974 1.00000

PCA: Brand Ratings

plot(brand.mu.pc, type="l")

PCA: Brand Ratings

biplot(brand.mu.pc, main="Brand positioning", cex=c(1.5, 1))

Interpreting the perceptual map

brand.mean
##   perform leader latest  fun serious bargain value trendy rebuy
## a    1.65   3.04   7.46 7.87    1.77    4.83  4.78   3.78  2.21
## b    7.47   7.21   8.43 3.40    7.61    4.37  4.70   7.25  4.33
## c    6.57   7.45   5.88 3.75    7.72    2.64  3.28   5.29  3.39
## d    2.31   2.87   7.28 6.58    2.40    1.91  2.10   7.24  2.47
## e    2.68   4.92   7.60 6.88    4.44    5.73  5.34   5.60  3.82
## f    4.30   5.12   2.31 5.47    5.96    6.59  6.79   2.99  7.18
## g    7.43   3.98   2.24 4.65    2.84    6.65  7.35   1.72  7.19
## h    4.44   3.64   7.74 8.03    3.93    2.29  2.46   7.59  2.19
## i    5.56   3.58   7.29 7.20    3.91    3.58  2.41   6.84  3.21
## j    2.47   2.36   5.72 6.85    2.65    4.00  4.16   3.90  1.28

Interpreting the perceptual map

Shifting positions

brand.mean["c", ] - brand.mean["e", ]
##   perform leader latest   fun serious bargain value trendy rebuy
## c    3.89   2.53  -1.72 -3.13    3.28   -3.09 -2.06  -0.31 -0.43

Interpreting the perceptual map

Shifting positions

colMeans(brand.mean[c("b", "c", "f", "g"), ]) - brand.mean["e", ]
##   perform leader latest     fun serious bargain value  trendy  rebuy
## e  3.7625   1.02 -2.885 -2.5625  1.5925 -0.6675  0.19 -1.2875 1.7025

Interpreting the perceptual map

Pitfalls

  • Aggregation is not always straightforward
  • Relationships are relative and sensitive
  • Strength cannot be read directly from chart

Lab Exercise 1

  • Develop a strategy for shifting product e to increase differentiation
  • You can change its mean scores but you must keep the sum of its scores the same as it is in the original data

Lab Exercise 2

  • You are introducing a new product into the market
  • Develop a plan for marketing it with the goal of occupying a differentiated space in which the existing products are not positioned

Lab Exercise 3

new_data <- read.csv(
  "https://static-content.springer.com/esm/art%3A10.1038%2Fs41598-020-67658-3/MediaObjects/41598_2020_67658_MOESM1_ESM.csv"
  )